unit alProvider;

interface

uses
  SysUtils, Classes, Variants, DB, DBClient, Provider, WideStrings, alSQLParser;

type
  TBaseSQLResolver = class(TSQLResolver)
  private
    FSQLParser: TSQLParser;
  protected
    procedure GenSelectSQL(Tree: TUpdateTree; SQL: TWideStrings; Params: TParams;
      Alias: string; Mode: TUpdateMode = upWhereKeyOnly); override;
    procedure GenWhereSQL(Tree: TUpdateTree; SQL: TWideStrings; Params: TParams;
      GenUpdateMode: TUpdateMode; Alias: string); override;
    property SQLParser: TSQLParser read FSQLParser;
  public
    constructor Create(AProvider: TDataSetProvider); reintroduce;
    destructor Destroy; override;
  end;

  TOnGetCommandTextEvent = procedure(Sender: TObject; var CommandText: string) of object;

  TBaseDataSetProvider = class(TDataSetProvider)
  private
    FCustomUpdate: Boolean;
    FSQLParser: TSQLParser;
    FOnGetCommandText: TOnGetCommandTextEvent;
    function GetTableName: string;
  protected
    procedure DoBeforeGetRecords(Count: Integer; Options: Integer;
      const CommandText: WideString; var Params, OwnerData: OleVariant); override;
    function CreateResolver: TCustomResolver; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property TableName: string read GetTableName;
  published
    property CustomUpdate: Boolean read FCustomUpdate write FCustomUpdate default True;
    property OnGetCommandText: TOnGetCommandTextEvent read FOnGetCommandText write FOnGetCommandText;
  end;

implementation

uses
  MidConst, SQLExpr;

type
  PSQLInfo = ^TSQLInfo;
  TSQLInfo = record
    IsSQLBased: Boolean;
    QuoteChar: WideString;
    QuotedTable: WideString;
    QuotedTableDot: WideString;
    Opened: Boolean;
    HasObjects: Boolean;
  end;

{ TBaseDataSetProvider }

constructor TBaseDataSetProvider.Create(AOwner: TComponent);
begin
  inherited;
  FCustomUpdate := True;
  FSQLParser := TSQLParser.Create;
end;

function TBaseDataSetProvider.CreateResolver: TCustomResolver;
begin
  if CustomUpdate then
    Result := TBaseSQLResolver.Create(Self)
  else
    Result := inherited CreateResolver;
end;

destructor TBaseDataSetProvider.Destroy;
begin
  FSQLParser.Free;
  inherited;
end;

procedure TBaseDataSetProvider.DoBeforeGetRecords(Count, Options: Integer;
  const CommandText: WideString; var Params, OwnerData: OleVariant);
var
  OldOptions: TProviderOptions;
  CustomParams: TParams;
  SQLFilterParam: TParam;
  SelectCommandText: string;
begin
  if Assigned(FOnGetCommandText) then
    FOnGetCommandText(Self, SelectCommandText)
  else
    SelectCommandText := CommandText;
  if (not VarIsEmpty(OwnerData)) and (not VarIsNull(OwnerData)) then
  begin
    CustomParams := TParams.Create(nil);
    try
      UnpackParams(OwnerData, CustomParams);
      SQLFilterParam := CustomParams.FindParam('SQLFilter');
      if Assigned(SQLFilterParam) then
        SelectCommandText := FSQLParser.AddSQLWhere(SelectCommandText, SQLFilterParam.Value);
    finally
      CustomParams.Free;
    end;
  end;
  OldOptions := Self.Options;
  Self.Options := Self.Options + [poAllowCommandText];
  inherited DoBeforeGetRecords(Count, Options, SelectCommandText, Params, OwnerData);
  Self.Options := OldOptions;
end;

function TBaseDataSetProvider.GetTableName: string;
var
  PS2: IProviderSUpport2;
begin
  if Supports(DataSet, IProviderSupport2, PS2) then
    Result := PS2.PSGetTableName;
end;

{ TBaseSQLResolver }

constructor TBaseSQLResolver.Create(AProvider: TDataSetProvider);
begin
  inherited;
  FSQLParser := TSQLParser.Create;
end;

destructor TBaseSQLResolver.Destroy;
begin
  FSQLParser.Free;
  inherited;
end;

procedure TBaseSQLResolver.GenSelectSQL(Tree: TUpdateTree; SQL: TWideStrings;
  Params: TParams; Alias: string; Mode: TUpdateMode);
var
  SelectSQL: string;
  Start, OldStart: PChar;
  Rest, FName: string;
  SQLToken, CurSection: TBaseSQLToken;
  HasWhere: Boolean;
begin
  SelectSQL := TSQLDataSet(Tree.Source).CommandText;
  Start := PChar(SelectSQL);
  CurSection := stUnknown;
  HasWhere := False;
  repeat
    OldStart := Start;
    SQLToken := FSQLParser.NextSQLToken(Start, FName, CurSection);
    if (SQLToken = stWhere) and (HasWhere = False) then
      HasWhere := True;
  until SQLToken in [stWhere, stGroupBy, stHaving, stUnion, stOrderBy, stEnd];
  Rest := string(OldStart);
  if SQLToken = stEnd then //Rest = ''
    SQL.Add(SelectSQL)
  else
    SQL.Add(Copy(SelectSQL, 1, Pos(Rest, SelectSQL)));
  GenWhereSQL(Tree, SQL, Params, Mode, Alias);
end;

procedure TBaseSQLResolver.GenWhereSQL(Tree: TUpdateTree; SQL: TWideStrings;
  Params: TParams; GenUpdateMode: TUpdateMode; Alias: string);
begin
  with PSQLInfo(Tree.Data)^ do
  begin
    QuotedTableDot := QuotedTable + '.';
    inherited;
  end;
end;

end.
